home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTMSG.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  14KB  |  519 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totMSG;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development History:
  12.              Jul 10 91  1.00a   Changed button centering algorithm
  13. }
  14.  
  15. INTERFACE
  16.  
  17. uses DOS, CRT, totSYS, totINPUT, totFAST, totIO1, totWIN, totSTR;
  18.  
  19. CONST
  20.    MaxButtons = 10;
  21.  
  22. TYPE
  23. MsgNodePtr = ^MsgNode;
  24. MsgNode = record
  25.    Txt : pointer;
  26.    Next: MsgNodePtr;
  27. end; {MsgNode}
  28.  
  29. ButtonDetails = record
  30.   Txt: stringbut;
  31.   Code: tAction;
  32.   HK: word;
  33.   Len : byte;
  34. end; {ButtonDetails}
  35.  
  36. pBaseMessageOBJ = ^BaseMessageOBJ;
  37. BaseMessageOBJ = object
  38.    vTxtStack: MsgNodePtr;
  39.    vManager: WinFormOBJ;
  40.    vTotLines: byte;
  41.    vStyle: byte;
  42.    vWidth : byte;
  43.    vButtonDepth: byte;
  44.    vMinWidth: byte;
  45.    vTotButtons: byte;
  46.    vButtons: array[1..MaxButtons] of pItemIOOBJ;
  47.    {methods ...}
  48.    constructor Init(Style:byte;Tit:string);
  49.    procedure   AddLine(Str:string);
  50.    function    MsgTxt(LineNo:byte): string;
  51.    function    WinForm: WinFormPtr;
  52.    procedure   AssignButton(var Button:ItemIOOBJ);
  53.    procedure   CalcSize;
  54.    function    Show: tAction;
  55.    destructor  Done;                                     VIRTUAL;
  56. end; {BaseMessageOBJ}
  57.  
  58. pMessageOBJ = ^MessageOBJ;
  59. MessageOBJ = object (BaseMessageOBJ)
  60.    vButtonText : stringbut;
  61.    vButtonHK: word;
  62.    {methods ...}
  63.    constructor Init(Style:byte;Tit:string);
  64.    procedure   SetOption(Str:string;Hotkey:word);
  65.    procedure   Show;
  66.    destructor  Done;                                     VIRTUAL;
  67. end; {MessageOBJ}
  68.  
  69. pButtonMessageOBJ = ^ButtonMessageOBJ;
  70. ButtonMessageOBJ = object (MessageOBJ)
  71.    {methods ...}
  72.    constructor Init(Style:byte;Tit:string);
  73.    procedure   Show;
  74.    destructor  Done;                                     VIRTUAL;
  75. end; {ButtonMessageOBJ}
  76.  
  77. pPromptOBJ = ^PromptOBJ;
  78. PromptOBJ = object (BaseMessageOBJ)
  79.    vButtonInfo : array [1..3] of ButtonDetails;
  80.    vTotPrompts: byte;
  81.    {methods ...}
  82.    constructor Init(Style:byte;Tit:string);
  83.    procedure   SetOption(ID:byte; Str:stringbut;HotKey:word; Act:tAction);
  84.    procedure   LoadButtonRecord(Rec:byte;Str:stringbut;Hotkey:word;Act:tAction);
  85.    function    Show: tAction;
  86.    destructor  Done;                                     VIRTUAL;
  87. end; {PromptOBJ}
  88.  
  89. pButtonPromptOBJ = ^ButtonPromptOBJ;
  90. ButtonPromptOBJ = object (promptOBJ)
  91.    {methods ...}
  92.    constructor Init(Style:byte;Tit:string);
  93.    function    Show: tAction;
  94.    destructor  Done;                                     VIRTUAL;
  95. end; {ButtonPromptOBJ}
  96.  
  97. procedure MsgInit;
  98.  
  99. IMPLEMENTATION
  100.  
  101. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  102. {                                                   }
  103. {    B a s e M e s s a g e O B J   M E T H O D S    }
  104. {                                                   }
  105. {|||||||||||||||||||||||||||||||||||||||||||||||||||}
  106. constructor BaseMessageOBJ.Init(Style:byte;Tit:string);
  107. {}
  108. begin
  109.    vTotLines := 0;
  110.    vStyle := Style;
  111.    vTxtStack := Nil;
  112.    vWidth := length(Tit) + 10;
  113.    vMinWidth := 10;
  114.    vTotButtons := 0;
  115.    vButtonDepth := 1;
  116.    with vManager do
  117.    begin
  118.       Init;
  119.       Win^.SetTitle(Tit);
  120.    end; 
  121. end; {BaseMessageOBJ.Init}
  122.  
  123. procedure BaseMessageOBJ.AddLine(Str:string);
  124. {}          
  125. var L : byte;
  126.     Temp: MsgNodePtr;
  127. begin
  128.    L := succ(length(Str));
  129.    if vTxtStack = Nil then
  130.    begin
  131.       getmem(vTxtStack,sizeof(vTxtStack^));
  132.       vTxtStack^.Next := nil;
  133.       if Str <> '' then
  134.       begin
  135.          getmem(vTxtStack^.Txt,L);
  136.          move(Str[0],vTxtStack^.Txt^,L);
  137.       end
  138.       else
  139.          vTxtStack^.Txt := nil;
  140.    end
  141.    else
  142.    begin
  143.       Temp := vTxtStack;
  144.       while Temp^.Next <> nil do
  145.          Temp := Temp^.Next;
  146.       getmem(Temp^.Next,sizeof(Temp^.Next^));
  147.       Temp := Temp^.Next;
  148.       Temp^.Next := nil;
  149.       if Str <> '' then
  150.       begin
  151.          getmem(Temp^.Txt,L);
  152.          move(Str[0],Temp^.Txt^,L);
  153.       end
  154.       else
  155.          Temp^.Txt := nil;
  156.    end;
  157.    inc(vTotLines);
  158. end; {BaseMessageOBJ.AddLine}
  159.  
  160. function BaseMessageOBJ.MsgTxt(LineNo:byte): string;
  161. {}
  162. var
  163.    Temp: MsgNodePtr;
  164.    I:integer;
  165.    L : byte;
  166.    Str: string;
  167. begin
  168.    Temp := vTxtStack;
  169.    for I := 2 to LineNo do
  170.       if Temp <> nil then
  171.          Temp := Temp^.Next;
  172.    if (Temp <> Nil) and (Temp^.Txt <> nil) then
  173.    begin
  174.       move(Temp^.Txt^,L,1);
  175.       move(Temp^.Txt^,Str[0],succ(L));
  176.    end
  177.    else
  178.       Str := '';
  179.    MsgTxt := Str;
  180. end; {BaseMessageOBJ.MsgTxt}
  181.  
  182. procedure BaseMessageOBJ.AssignButton(var Button:ItemIOOBJ);
  183. {}
  184. begin
  185.    if vTotButtons < MaxButtons then
  186.    begin
  187.       inc(vTotButtons);
  188.       vButtons[vTotButtons] := @Button
  189.    end;
  190. end; {BaseMessageOBJ.AssignButton}
  191.  
  192. procedure BaseMessageOBJ.CalcSize;
  193. {}
  194. var
  195.    X1,Y1,X2,Y2: shortint;
  196.    Height: byte;
  197.    I : integer;
  198.    Str : string;
  199. begin
  200.    for I := 1 to vTotLines do
  201.    begin
  202.       Str := MsgTxt(I);
  203.       if length(Str) > vWidth then
  204.          vWidth := length(Str);
  205.    end;
  206.    if vWidth < vMinWidth then
  207.       vWidth := vMinWidth
  208.    else if vWidth > 80 then
  209.       vWidth := 76;
  210.    if (vStyle <> 0) then
  211.       vWidth := vWidth + 2;
  212.    X1 := (Monitor^.Width - vWidth) div 2;
  213.    X2 := X1 + pred(vWidth);
  214.    case vStyle of
  215.       0: Height := vTotLines;
  216.       6: Height := vTotLines + 3;
  217.       else Height := vTotLines + 2;
  218.    end; {case}
  219.    inc(Height,succ(vButtondepth));
  220.    Y1 := (Monitor^.Depth - Height) div 2;
  221.    Y2 := Y1 + pred(Height);
  222.    vManager.Win^.SetSize(X1,Y1,X2,Y2,vStyle);
  223. end; {BaseMessageOBJ.CalcSize}
  224.  
  225. function BaseMessageOBJ.Show:tAction;
  226. {}
  227. var
  228.    I : integer;
  229.    S : string;
  230. begin
  231.    for I := 1 to vTotButtons do
  232.       vManager.AddItem(vButtons[I]^);
  233.    vManager.Draw;
  234.    for I := 1 to vTotLines do
  235.    begin
  236.       S := MsgTxt(I);
  237.       if S <> '' then
  238.          case S[1] of
  239.             '^': begin
  240.                delete(S,1,1);
  241.                Screen.WriteCenter(I,vManager.Win^.GetBodyAttr,S);
  242.             end;
  243.             '"': begin
  244.                delete(S,1,1);
  245.                Screen.WriteRight(vWidth - 2*ord(vStyle<>0),I,
  246.                                  vManager.Win^.GetBodyAttr,S);
  247.             end;
  248.             else   Screen.WritePlain(1,I,S);
  249.          end;  {case}
  250.    end;
  251.    Show := vManager.Go;
  252.    delay(100);
  253.    vManager.Done;
  254. end; {BaseMessageOBJ.Show}
  255.  
  256. function BaseMessageOBJ.WinForm: WinFormPtr;
  257. {}
  258. begin
  259.    WinForm := @vManager;
  260. end; {BaseMessageOBJ.WinForm}
  261.  
  262. destructor BaseMessageOBJ.Done;
  263. {}
  264. var
  265.   L: byte;
  266.   TempA,TempB: MsgNodePtr;
  267.   I : integer;
  268. begin
  269.    TempA := vTxtStack;
  270.    while TempA <> nil do
  271.    begin
  272.        TempB := TempA;
  273.        TempA := TempB^.Next;
  274.        if TempB^.Txt <> Nil then
  275.        begin
  276.           move(TempB^.Txt^,L,1);
  277.           freemem(TempB^.Txt,succ(L)); {dispose of text}
  278.        end;
  279.        freemem(TempB,sizeof(tempB^));
  280.    end;
  281. end; {BaseMessageOBJ.Done}
  282. {||||||||||||||||||||||||||||||||||||||||||||}
  283. {                                            }
  284. {     M e s s a g e O B J   M E T H O D S    }
  285. {                                            }
  286. {||||||||||||||||||||||||||||||||||||||||||||}
  287. constructor MessageOBJ.Init(Style:byte;Tit:string);
  288. {}
  289. begin
  290.    BaseMessageOBJ.Init(Style,Tit);
  291.    vButtonText := '  ~O~K  ';
  292.    vButtonHK :=  79;
  293. end; {MessageOBJ.Init}
  294.    
  295. procedure MessageOBJ.SetOption(Str:string;HotKey: word);
  296. {}
  297. begin
  298.    vButtonText := Str;
  299.    vButtonHK := HotKey;
  300. end; {MessageOBJ.SetOptionText}
  301.  
  302. procedure MessageOBJ.Show;
  303. {}
  304. var
  305.    OK: Strip3dIOOBJ;
  306.    EscHK: HotKeyIOOBJ;
  307.    HK: HotKeyIOOBJ;
  308.    TempAct: tAction;
  309. begin
  310.    vMinWidth := length(vButtonText) + 4;
  311.    CalcSize;
  312.    OK.Init(succ((vWidth - length(vButtonText)))div 2 ,succ(vTotLines),vButtonText,Finished); {1.00a}
  313.    EscHK.Init(27,Finished);
  314.    OK.SetHotkey(vButtonHK);
  315.    AssignButton(OK);
  316.    AssignButton(EscHK);
  317.    TempAct := BaseMessageOBJ.Show;
  318.    OK.Do